home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 81 / 64er_Magazin_Sonderheft_81_19xx_Markt__Technik_de_Side_A.d64 / shapes demo2 (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  219 lines
  1. 10 rem        shapes demo
  2. 20 :
  3. 30 rem     richard l. rylander    11/23/84 (revised 1/20/85 to add labeling)
  4. 40 :
  5. 50 gr=49378    :rem graphik modus
  6. 60 tx=49411    :rem text modus
  7. 70 :
  8. 80 lb=893      :rem linke grenze
  9. 90 rb=894      :rem rechte grenze
  10. 100 ub=895     :rem obere grenze
  11. 110 db=896     :rem untere grenze
  12. 120 :
  13. 130 rem   flags fuer verschiedene grafikmodi
  14. 140 :
  15. 150 sh=838     :rem schattierung: 0=random, 1=halbton
  16. 160 sc=839     :rem skalierung:0=normal (1:1), 1=skal. (4:3) fuer darstellung
  17. 170 lt=898     :rem lichteinfall: 0=normal, 1=von hinten beleuchtet
  18. 180 :
  19. 190 bo=53280   :rem  rahmenfarbe
  20. 200 :
  21. 210 rem   funktionsadressen
  22. 220 :
  23. 230 cl=51979   :rem bitmap bereich loeschen
  24. 240 co=52001   :rem colorbereich fuellen
  25. 250 :
  26. 260 sp=52119   :rem  sphere
  27. 270 tr=52141   :rem  ring von oben
  28. 280 vc=52150   :rem  zylinder (vertikale achse)
  29. 290 hc=52153   :rem  zylinder (horizontale achse)
  30. 300 vt=52186   :rem  ringschnitt (vertikale achse)
  31. 310 ht=52189   :rem  ringschnitt (axis horizontale achse)
  32. 320 vs=52203   :rem  spule (vertikale achse)
  33. 330 hs=52206   :rem  spule (horizontale achse)
  34. 340 :
  35. 350 rem  einzelne shapes zeichnen
  36. 360 :
  37. 370 poke sh,1 :rem halbtonschattierung
  38. 380 poke sc,1 :rem skalierung
  39. 390 poke lt,0 :rem normalbeleuchtung
  40. 400 sys(cl)   :rem bildschirm loeschen
  41. 410 sys(co),17*11+1  :rem farbkombination - dunkelgrau (11) weisse punkte (1)
  42. 414 rem  auf den meisten farbmonitoren
  43. 420 poke bo,1 :rem weisser rahmen
  44. 430 sys(gr)   :rem grafik einschalten
  45. 432 rw=12:cm=14:md=1:a$="shapes demo":gosub 1900:rem  titel
  46. 434 x1=110:y1=120:x2=210:y2=120:bc=1:dc=7:gosub 1700:rem  color titel
  47. 440 poke lb,38:poke rb,38:poke ub,38:poke db,38       :rem shape fenster
  48. 450 sys(sp),40,199,38
  49. 455 rw=9:cm=2:md=1:a$="kugel":gosub1900
  50. 460 sys(hc),120,199,38,38
  51. 465 cm=11:a$="h-zylnd.":gosub1900
  52. 470 sys(vc),200,199 :rem voreingestellte parameter werden benutzt
  53. 475 cm=21:a$="v-zylind.":gosub1900
  54. 480 sys(tr),280,199,15,38
  55. 485 cm=32:a$="  ring":gosub1900
  56. 490 sys(vt),40,64
  57. 495 rw=23:cm=1:a$="h-ring":gosub1900
  58. 500 sys(ht),120,64
  59. 505 cm=11:a$="v-ring":gosub1900
  60. 510 sys(hs),200,64,5,100
  61. 515 cm=22:a$="h-spule":gosub1900
  62. 520 sys(vs),280,64
  63. 525 cm=32:a$="v-spule":gosub1900
  64. 530 poke 198,0:wait 198,1:poke 198,0
  65. 540 rem  auf taste warten
  66. 550 :
  67. 560 rem  zwei "pokale", einer mit halbton-, der andere mit "random"-schattierung
  68. 570 :
  69. 580 sys(cl):sys(co),16*11+1
  70. 582 rw=14:cm=14:a$="vergleich":gosub 1900:rw=15:cm=16:a$="zweier":gosub 1900
  71. 584 rw=16:cm=12:a$="schattierungen":gosub 1900:rw=18:cm=14:a$="<-- halbton"
  72. 586 gosub 1900:rw=20:cm=15:a$="random -->":gosub 1900
  73. 590 poke lb,255:poke rb,255:poke ub,49:poke db,255: rem an den oberen rand
  74. 600 sys(sp),80,190,80
  75. 610 poke ub,51:poke db,51: rem weitern sprite-teil anhaengen
  76. 620 sys(vs),80,69,10,130
  77. 630 poke db,9:poke ub,8
  78. 640 sys(vt),80,9,25,45
  79. 650 poke sh,0  :rem auf random schattierung umschalten
  80. 660 poke lb,255:poke rb,255:poke ub,49:poke db,255
  81. 670 sys(sp),240,190,80
  82. 680 poke ub,51:poke db,51
  83. 690 sys(vs),240,69,10,130
  84. 700 poke db,9:poke ub,8
  85. 710 sys(vt),240,9,25,45
  86. 720 poke 198,0:wait 198,1:poke 198,0
  87. 740 :
  88. 750 rem  zeichne "wein" szene
  89. 760 poke lt,1 :rem hintergrungbeleuchtung
  90. 770 poke sh,1 :rem halbtonschattierung fuer flaschenetikett
  91. 780 sys(co):sys(cl),255: rem bitmap fuellen
  92. 790 poke bo,0 : rem schwarzer hintergrund
  93. 792 rw=0:cm=0:md=2:a$="zeichenen mit":gosub 1900:rw=1:cm=0:a$="rueckbeleuchtung"
  94. 794 gosub 1900:rw=2:cm=0:a$="gegen gesetzten":gosub 1900
  95. 796 rw=3:cm=0:a$="hintergrund":gosub 1900
  96. 798 rw=1:cm=26:a$="farben werden":gosub 1900
  97. 800 rw=2:cm=26:a$="nachgezeichnet":gosub1900
  98. 810 rem  zeichne flasche
  99. 820 poke ub,0:poke db,255:poke lb,255:pokerb,255
  100. 830 sys(vt),150,10,30,50
  101. 840 poke ub,255:sys(vc),150,70,50,60
  102. 850 poke db,0:sys(vt),150,130,6,50
  103. 860 poke db,55:poke ub,0:sys(vs),150,204,15,181
  104. 870 poke ub,255:sys(vc),150,221,16,17
  105. 880 :
  106. 890 rem  zeichene weinglas
  107. 900 poke ub,20:sys(sp),80,120,60
  108. 910 poke ub,35:poke db,34:sys(vs),80,34,10,110
  109. 920 :
  110. 930 rem  zeichent ein paar trauben
  111. 940 sys(sp),8,8,8:
  112. 950 sys(sp),20,8:sys(sp),40,8:sys(sp),12,20:sys(sp),30,20:sys(sp),25,16
  113. 960 :
  114. 970 rem zeichnet apfel bestehend aus 2 ringen und einem kugelfragment
  115. 980 poke ub,255:poke db,255:poke lb,255:poke rb,59
  116. 990 sys(vt),260,29,0,50:sys(vt),260,79
  117. 1000 poke ub,43:poke db,43:sys(sp),260,54,60
  118. 1010 rem   apfelstiel zeichnen
  119. 1020 poke rb,0:poke db,0:sys(tr),272,104,10,15
  120. 1030 rem   blatt zeichnen
  121. 1040 poke db,255:poke rb,0:sys(sp),256,119,15
  122. 1050 rem  "random"-schattiertes ettikett hinzufuegen !
  123. 1060 poke ub,255:poke rb,255:poke lb,6
  124. 1070 poke sh,0:sys(vc),150,72,50,48
  125. 1080 :
  126. 1090 rem  bild nachcolorieren
  127. 1100 sys(co),12
  128. 1110 x1=200:y1=1:x2=315:y2=100:dc=0:bc=2:gosub 1700
  129. 1120 x1=240:y1=110:x2=255:y2=150:bc=5:gosub 1700
  130. 1130 x1=260:y1=110:x2=270:y2=135:bc=9:gosub 1700
  131. 1140 x1=1:y1=1:x2=48:y2=30:bc=4:gosub 1700
  132. 1150 x1=140:y1=205:x2=180:y2=235:bc=7:gosub 1700
  133. 1160 x1=145:y1=25:x2=195:y2=115:bc=6:gosub 1700
  134. 1170 poke 198,0:wait 198,1:poke 198,0
  135. 1190 :
  136. 1200 rem   "kaffee und plaetzchen"
  137. 1210 poke sh,0 :rem random-schattierung fuer plaetzchen
  138. 1220 sys(co),16*11+1:sys(cl):poke bo,1
  139. 1230 poke lb,255:poke rb,255:poke ub,255:poke db,255 :rem kein shape-fenster
  140. 1240 sys(vt),60,20,20,60
  141. 1250 poke rb,29:sys(vt),99,60:poke rb,255
  142. 1260 sys(tr),188,180
  143. 1270 rem halbtonschattierte kaffeetasse hinzufuegen.
  144. 1280 poke sh,1:poke ub,0:sys(vt),188,20:poke ub,255
  145. 1290 poke db,0:sys(tr),278,110,20,40
  146. 1300 poke db,255:poke ub,0:poke lb,0
  147. 1310 sys(tr),248,90,50,70:poke lb,255:sys(sp),248,110,10:poke ub,255
  148. 1320 sys(vc),308,100,10,10
  149. 1330 sys(vc),188,77,60,57
  150. 1340 poke db,0:sys(vt),188,134,40,60
  151. 1360 sys(co),1+16*9 :rem 1=weisser hintergrund, 9=braune punkte
  152. 1370 x1=130:y1=1:x2=319:y2=136:bc=1:dc=5:gosub 1700
  153. 1380 x1=250:y1=144:x2=319:y2=144:gosub 1700
  154. 1390 poke 198,0:wait 198,1:poke 198,0
  155. 1410 :
  156. 1420 rem  zeichne "verbundene" ringe durch ueberlappung der fenster
  157. 1430 poke lt,0 :rem blaue punkte auf weiss, keine hintergrundbeleutung
  158. 1440 sys(cl):sys(co),1+16*6: rem 1=weisser intergrund, 6=blaue punkte
  159. 1450 poke ub,255:poke db,255:poke lb,255:poke rb,255: rem keine fenster
  160. 1460 poke sh,0  :rem zufaellige schattierung
  161. 1470 sys(tr),244,84,48,70
  162. 1480 sys(tr),160,84:sys(tr),76,84
  163. 1490 sys(tr),118,156:sys(tr),202,156
  164. 1500 rem  ueberlappende zonen hinzufuegen
  165. 1510 poke rb,0:poke db,0:sys(tr),160,84:poke rb,255:poke lb,0
  166. 1520 sys(tr),76,84:poke db,255:poke ub,0:sys(tr),118,156
  167. 1530 poke lb,255:poke rb,0:sys(tr),202,156:poke lb,27
  168. 1540 poke db,0:poke ub,255:sys(tr),160,84
  169. 1550 poke db,0:poke ub,255:sys(tr),160,84
  170. 1560 poke lb,255:poke ub,27:sys(tr),244,84
  171. 1570 poke lb,0:poke rb,27:poke ub,255:sys(tr),244,84
  172. 1580 poke 198,0
  173. 1590 get a$:if a$= "" then 1590
  174. 1600 sys(tx):poke bo,14:rem rueckkehr zum textmodus
  175. 1610 end
  176. 1620 :
  177. 1630 rem unterprogramm zu nachcolorieren verschiedener zonen
  178. 1640 rem achtung: es kann jeweils nur eine rechteckige flaeche
  179. 1650 rem von 8x8 punkten eingefaerbt werden !!
  180. 1660 rem (x1,y1)=unterer linker punkt, (x2,y2)=oberer rechter punkt
  181. 1690 rem die y-koordinaten muessen "unskalliert" sein. falls scale-flag gesetzt:
  182. 1700 if peek(sc)then y1=(y1+1)*213/256:y2=(y2+1)*213/256
  183. 1710 rem uebergabevariable ist cc.
  184. 1720 rem cc=16*dc + bc [dc=punkt farbe, bc= hintergrundfarbe]
  185. 1730 cc=16*dc+bc
  186. 1740 for ix=int(x1/8) to int(x2/8)
  187. 1750 for iy=int(y1/8) to int(y2/8)
  188. 1760 poke 34752+ix-40*iy,cc
  189. 1770 next:next:return
  190. 1780 :
  191. 1790 rem "text"-unterroutine ermoeglicht einfuegen von text in die bilder.
  192. 1800 rem "rw" und "cm" sind die zeilen(0-24) und spalten(0-39) koordinaten des
  193. 1810 rem ersten buchstaben des zu druckenden textstrings.
  194. 1820 rem uebergabevariable fuer text ist a$
  195. 1830 rem "md" zeigt den druckmodus an:
  196. 1840 rem  1 - normal ("schwarze" buchstaben auf "weissem" hintergrund)
  197. 1850 rem  2 - inverse ("weisse" buchstaben auf "schwarzem" hintergrund)
  198. 1860 rem  3 - buchstaben werden mit logischem oder mit hintergrund verknuepft.
  199. 1870 rem  4 - buchstaben werden mit logischem und mit hintergrund verknuepft.
  200. 1880 rem  5 - buchstaben werden mit logischem exor mit hintergrund verknuepft.
  201. 1890 :
  202. 1900 sb=40952:tb=54272:if(md and 1)then tb=53248:rem basisadressen
  203. 1910 os=320*rw+8*cm:rem  adresse des zeichengenerators
  204. 1920 poke 56334,peek(56334)and 254:rem disable irq timer
  205. 1930 poke 1,peek(1)and 251:rem character rom einschalten
  206. 1940 l=len(a$):for n=1 to l:n8=n*8+os+sb
  207. 1950 x=asc(mid$(a$,n,1)):if x>63 then x=x-64
  208. 1960 tc=tb+8*x
  209. 1970 on md goto 1980,1980,1990,2000,2010
  210. 1980 poke 53231,36:goto 2020
  211. 1990 poke 53231,17:goto 2020
  212. 2000 poke 53231,49:goto 2020
  213. 2010 poke 53231,81
  214. 2020 poke252,n8/256:poke251,n8-256*int(n8/256)
  215. 2030 poke254,tc/256:poke253,tc-256*int(tc/256)
  216. 2040 sys(53221):next
  217. 2050 poke 1,peek(1)or 4:poke 56334,peek(56334)or 1:rem normal schalten
  218. 2060 return
  219.